perm filename Z[XX,LCS]1 blob
sn#206571 filedate 1976-03-14 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ***** COPYIT
C00009 ENDMK
Cā;
;***** COPYIT
TITLE COPYIT
INTERNAL COPYIT,UPDN,STFCH
EXTERNAL .COMM.,POSI,XRN,PTR
EXTERNAL OUTLIM,RTLINE,LOOP
;; DEFINE FLOAT(N)
;; < TLC N,232000
;; FADR N,N >
DEFINE FIXX(N)
< JUMPGE N,.+5
MOVNS N
FIX N,233000
MOVNS N
CAIA
FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
; SUBROUTINE COPYIT
; COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
; 1/PTR/PWDS(250),ITEM,LL,I,IX
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
; 1,(R6,RJQ(4)),(N,RN(2500))
STFCH: 0
SETO 13, ;FLAG FOR STFCH ROUTINE
JRST .+3
COPYIT: 0
SETZ 13, ;MAKE SURE IT'S 0
SETZ 7, ;IM=ITEM
MOVE 15,PTR+=252 ; AC7 IS K-1
SOJ 15, ;(ITEM-1)
CP1: JSA 16,RTLINE ;DO 1 K=1,IM
JUMP PTR(7) ;L=PWDS(K)
JUMPL CPY ; IF(RTLINE(L))GO TO 1
JSA 16,OUTLIM ;IF(OUTLIM(L,3))GO TO 1
JUMP PTR(7)
JUMP [3]
JUMPL CPY
MOVE 11,PTR(7) ; NOW L IS AC11
MOVE 10,.COMM.+7 ;IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
JUMPE 10,CP3
CAMN 10,XRN(11)
JRST CPY
CP3: JUMPL 13,STF2 ; SKIP OVER FOR STFCH ROUTINE
MOVE 12,XRN-1(11)
FIXX(12) ;M=RN(L)+2
ADDI 12,2
JSA 16,LOOP ;CALL LOOP(0,M,1,I,L,RN)
JUMP [0]
JUMP 12
JUMP [1]
JUMP PTR+=252
JUMP 11
JUMP XRN
AOS PTR+=250 ;ITEM=ITEM+1
MOVE 13,PTR+=250
MOVE 11,PTR-1(13) ;L=PWDS(ITEM)
STF2: MOVE 14,.COMM.+=8 ;RN(L+2)=R7
MOVEM 14,XRN+1(11)
JUMPGE 13,CP2
SKIPL POSI+=8
JRST CPY
MOVE 14,7
AOJ 14,
MOVEM 14,POSI+=8
JRST CPY
CP2: SKIPGE POSI+=8 ;IF(JJ2)JJ2=ITEM
MOVEM 13,POSI+=8
AOJ 12, ;I=I+M+1
ADDM 12,PTR+=252
MOVEM 12,PTR(13) ;PWDS(ITEM+1)=I
CPY: AOJ 7, ;1 CONTINUE
CAMGE 7,15
JRST CP1
MOVE 7,.COMM.+=8 ;R2=R7
MOVEM 7,.COMM. ;DOES THIS MATTER FOR STFCH}
JRA 16,(16) ;END
;SUBROUTINE STFCH
;INTEGER PWDS
;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
;1/PTR/PWDS(250),ITEM,LL,I,IX
;EQUIVALENCE (R7,RJQ(5)),(R6,RJQ(4))
;DO 1 K=1,ITEM
;L=PWDS(K)
;IF(RTLINE(L))GO TO 1
;IF(OUTLIM(L,3))GO TO 1
;IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
;C DIDN'T MATCH THE CODE NUM.
;IF(JJ2)JJ2=K
;RN(L+2)=R7
;1 CONTINUE
;END
UPDN: 0 ;SUBROUTINE UPDN(NST)
;INTEGER PWDS
;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
;1/PTR/PWDS(250),ITEM,LL,I,IX
MOVE 7,@(16) ;EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
SOJ 7, ;1,(R6,RJQ(4))
UPDN0: JSA 16,RTLINE ;DO 1 K=NST,ITEM
JUMP PTR(7) ;L=PWDS(K)
JUMPL UPDN1 ; IF(RTLINE(L))GO TO 1
MOVE 11,PTR(7) ;RY=RN(L+1) -- 11 IS L
MOVE 12,XRN(11) ;IF(RY.GT.16)GO TO 1
CAMG 12,[16.0] ; AC12=RY
CAMN 12,[8.0] ;IF(RY.EQ.8)GO TO 1
JRST UPDN1
CAMN 12,[3.0] ;IF(RY.EQ.3)GO TO 1
JRST UPDN1
CAMN 12,.COMM.+7 ;IF(RY.EQ.R6)GO TO 10
JRST UPDN10
SKIPE .COMM.+7 ;IF(R6.NE.0)GO TO 1
JRST UPDN1
UPDN10: CAME 12,[4.0] ; DIDN'T MATCH THE CODE NUM.
JRST UPDN11 ;10 ;IF(RY.NE.4)GO TO 11
MOVE 2,XRN-1(11) ;IF(RN(L).LT.3)GO TO 1
CAMGE 2,[3.0]
JRST UPDN1 ; A BAR LINE
UPDN11: JSA 16,OUTLIM ;11 IF(OUTLIM(L,3))GO TO 2
JUMP PTR(7)
JUMP [3]
JUMPL UPDN2
MOVE 2,.COMM.+=12 ;RN(L+4)=RN(L+4)+R11
FADRM 2,XRN+3(11)
SKIPL POSI+=8 ;IF(JJ2)JJ2=K
JRST UPDN2
MOVE 2,7
AOJ 2,
MOVEM 2,POSI+=8
UPDN2: CAML 12,[4.0] ;2 ;IF(RY.LT.4)GO TO 1
CAML 12,[7.0] ;IF(RY.GE.7)GO TO 1
JRST UPDN1 ; NO WIGGLE ON TRILL
CAME 12,[4.0] ;IF(RY.NE.4.)GO TO 12
JRST UPDN12
MOVE 15,XRN+4(11) ;IF(RN(L+5).EQ.50)GO TO 1
CAMN 15,[50.0] ; 15 IS RN(L+5)
JRST UPDN1 ; CRESC. OR BOX
UPDN12: JSA 16,OUTLIM ;12 ;IF(OUTLIM(L,6))GO TO 1
JUMP PTR(7)
JUMP [6]
JUMPL UPDN1
MOVE 3,.COMM.+=12 ;RN(L+5)=RN(L+5)+R11
FADRM 3,XRN+4(11)
SKIPL POSI+=8 ;IF(JJ2)JJ2=K
JRST UPDN1
MOVE 2,7
AOJ 2,
MOVEM 2,POSI+=8
UPDN1: AOJ 7, ;1 ;CONTINUE
CAMGE 7,PTR+=250
JRST UPDN0
JRA 16,@1(16) ;END
END